COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	Here are the changes to MacLisp to make the pdlov thing go away
C00015 ENDMK
C⊗;
Here are the changes to MacLisp to make the pdlov thing go away
IN DEFNS >:

;macros here

DEFINE %			;THIS IS GOOD FOR LIST STRUCTURE
,,.+1!TERMIN


DEFINE INFORM R,S,T,U,V,W,X,Y,Z,$,%
PRINTX ≤	R!S!T!U!V!W!X!Y!Z!$!%
≤
TERMIN

DEFINE WARN R,S,T,U,V,W,X,Y,Z,$,%
WARN1 [R!S!T!U!V!W!X!Y!Z!$!%]
TERMIN

DEFINE WARN1 CRUFT
IFL 40-.LENGTH ≤CRUFT≤,[ .ERR ######
PRINTX ≤	###### CRUFT
≤
]
.ELSE .ERR ###### CRUFT
TERMIN

;;; USEFUL MACRO FOR .FASL FILES.  CAUSES LOADING TO PRINT MESSAGE.

DEFINE VERPRT NAME
.SXEVAL    (COND ((STATUS NOFEATURE NOLDMSG)
		  (TERPRI MSGFILES)
		  (TYO #73  MSGFILES)
		  (PRINC (QUOTE L/o/a/d/i/n/g/ NAME/ ) MSGFILES)
		  (DO ((N #<.FNAM2> (LSH N #6 )))
		      ((ZEROP N))
		      (TYO (PLUS #40  (LSH N #-30. ))
			   MSGFILES))))

TERMIN

;MACRO TO HANDLE UNWIND-PROTECT
;	UNWINDPROTECT CODE,CONTINUATION-CODE
;CAUSES CONTINUATION TO BE INVOKED AFTER CODE IS EXECUTED
;THE STATE OF THE PDLS MUST BE THE SAME BEFORE AND AFTER CODE EXECUTES.
;  CODE SHOULD BE THOUGHT OF AS A FUNCTION CALL.
; CODE IS THE CODE TO BE INVOKED AND PROTECTED.
; CONT IS THE "CONTINUATION" TO BE RUN WHEN UNWINDING THE STACK, OR AFTER
;    CODE IS RUN
DEFINE UNWINDPROTECT CODE,CONT,\LABEL
	JSP TT,PTNTRY		   ;SETUP AN UNWIND PROTECT
	JRST LABEL
	CONT
	POPJ P,
LABEL:
	CODE
;ASSUMPTION IS THAT FOLLOWING JSP CLOBBERS THE WORLD
	JSP TT,PTEXIT		   ;RUN CONTINUATION, PRESERVES A
TERMIN

IFN SAIL,[
DEFINE FIXPDLP FREEAC
	HRRZ FREEAC,P
	MOVE P,C2
	SUBI FREEAC,(P)
	HRLS FREEAC
	ADD P,FREEAC
TERMIN

DEFINE FIXPDLFXP FREEAC
	HRRZ FREEAC,FXP
	MOVE FXP,FXC2
	SUBI FREEAC,(FXP)
	HRLS FREEAC
	ADD FXP,FREEAC
TERMIN

DEFINE FIXPDLFLP FREEAC
	HRRZ FREEAC,FLP
	MOVE FLP,FLC2
	SUBI FREEAC,(FLP)
	HRLS FREEAC
	ADD FLP,FREEAC
TERMIN

DEFINE FIXPDLSP FREEAC
	HRRZ FREEAC,SP
	MOVE SP,SC2
	SUBI FREEAC,(SP)
	HRLS FREEAC
	ADD SP,FREEAC
TERMIN

]	;END OF IFN SAIL

IN *LISP >:

;here
UIBRK:	EXCH D,TT		;UNWIND-PROTECT NEEDS STACK POINTER IN AC TT
	PUSHJ FXP,UNWPRO	;HANDLE UNWIND PROTECTION
	EXCH D,TT
	HRRM TT,-1(D)

IFN SAIL,[
   	HRRZ FXP,1(D)
	FIXPDLFXP AR1
]	;END OF IFN SAIL

SA%	HRRO FXP,1(D)		;JUST SET LEFT HALF OF PDL POINTERS

IFN SAIL,[
   	HLRZ FLP,1(D)
	FIXPDLFLP AR1
]	;END OF IFN SAIL

SA%	HLRO FLP,1(D)		; TO -1 FOR BIBOP, AND LET PDLOV

IFN SAIL,[
   	HRRZI P,-UIFRM(D)
	FIXPDLP AR1

]	;END OF IFN SAIL

SA%	HRROI P,-UIFRM(D)
	MOVEM F,UISAVT-T+F(FXP)	;LET F BE SAFE OVER RESTORATION
	MOVEM T,UISAVT(FXP)	;T TOO
	MOVEM C,UISAVA-A+C(P)	;C TOO
	MOVEM B,UISAVA-A+B(P)	;B TOO
	MOVEM A,UISAVA(P)	;A TOO
	JRST UINT0X

;THIS ROUTINE FINDS ALL UNWIND-PROTECTS BETWEEN THE CURRENT STACK POSITION
; AND THE DESIRED STACK POSITION (AS FOUND IN TT).  IF AN UNWIND-PROTECT IS
; FOUND, THEN:
;   A) THE UNWIND-PROTECT STACK FRAME IS POP'ED *WITHOUT UPDATING FXP OR FLP*
;   B) SP IS UNWOUND TO THE CURRENT BINDING LEVEL
;   C) THE FUNCTION IS CALLED WITH EVERYTHING SAVED
;   D) WHEN THE FUNCTION RETURNS, ACS ARE RESTORED AND THE ROUTINE CONTINUES
;      SEARCHING FOR THE NEXT UNWIND PROTECT
; WHEN NO MORE UNWIND PROTECTS EXIST IN THE SPECIFIED RANGE OF THE PDL,
; THIS ROUTINE RETURNS TO ITS CALLER, WHICH IS EXPECTED TO RESTORE
; FXP AND FLP (AND POSSIBLY OTHERS) FROM THE STACK FRAME THAT WAS USED TO STOP
; THE UNWIND-PROTECT SEARCH
; CALLED WITH PUSHJ FXP,
; TT CONTAINS LOWEST ADR TO SEARCH
; PRESERVES ALL AC'S
UNWPRO:
;;; AMOUNT OF STUFF THAT GETS PUSHED MUST BE WELL DEFINED, CHANGE UNWPUS
;;; IF IT CHANGES
.SEE UNWPUS
	PUSH FXP,D
	PUSH FXP,T
	PUSH FXP,R
	PUSH FXP,TT
;;;
	HRRZS TT		;ONLY PDL PART
	MOVEI R,(SP)		;CURRENT VALUE OF SP IN CASE NO FRAMES FOUND
UNWPR2:	SKIPE D,CATRTN
UNWPR1:	 CAILE TT,(D)		;HAVE WE GONE TOO FAR?
	  JRST UNWPRT		;NO MORE FRAMES POSSIBLE, SO RETURN
	HRLZI T,CATUWP		;IS THIS AN UNWIND-PROTECT FRAME?
	TDNN T,(D)
	 JRST UNWNXT		;NOT UNWIND-PROTECT, SO SKIP THIS FRAME

IFN SAIL,[
 	HRRZ P,D
	FIXPDLP T
]	;END OF IFN SAIL

SA%	HRRO P,D		;RESET PDL, WILL WORK BY PDL OV NEXT PUSH
;;; PUSH NOTE
.SEE UNWPUS
	PUSH FXP,UNREAL		;FROM THIS POINT ON ALLOW NO USER INT'S
;;;
	SETOM UNREAL
	LOCKI
	MOVE T,(P)		;GET POINTER TO UNWIND HANDLER
	MOVSI D,-LEP1+1(P)	;RESTORE HAS FRAME (SNARFED FROM ERR1)
	HRRI D,ERRTN
	BLT D,ERRTN+LEP1-1
	SUB P,EPC1
	POP P,D			;GET OLD FXP
	POP P,FLP		;RESTORE FLP
	POP P,R			;SAVE LEVEL TO SP UNWIND TO
	POP P,PA3
	PUSHJ FXP,SAV5		;SAVE ALL PROTECTED ACS
	MOVEI B,(T)		;POINTER TO COMPILED FUNCTION OR LIST
UNLOCKI
;;; PUSH NOTE
.SEE UNWPUS
	PUSHJ P,SAVX5		;AND UNPROTECTED ONES
;;;
	HRRI T,(D)
	MOVEI TT,(R)
	PUSHJ P,UBD0		;UNWIND SP
	MOVEI TT,(T)
	TLNN T,CATCOM		;COMPILED CODE?
	 JRST UNWNCM		;NOPE, USE PROGN
UNWPUS==:13			;NUMBER OF PUSHES DONE ON FXP
	HRLI TT,-<UNWPUS-1>(FXP);BLT POINTER TO DATA THAT MUST BE MOVED
	AOS TT
	MOVEI D,UNWPUS-1(TT)	;BLT END POINTER
	BLT TT,(D)		;BLT ALL IMPORTANT FXP DATA

IFN SAIL,[
 	PUSH P,TT
 	HRRZI TT,FXP
	FIXPDLFXP TT
 	POP P,TT
]	;END OF IFN SAIL

SA%	HRROI FXP,(D)		;NEW FXP
	PUSHJ P,(B)		;INVOKE THE UNWINDPROTECTION CODE
	SKIPA
UNWNCM:	 PUSHJ P,IPROGN
	MOVE A,-5(FXP)		;GET OLD VALUE OF UNREAL, ALSO SETS UP THIS VALUE
	SKIPL A			;NO NEED TO CALL IF ALL INTERRUPTS BEING DEFFERED ANYWAY
	 PUSHJ P,CHECKU		;AND SEE IF INTERRUPTS TO BE RUN
	PUSHJ P,RSTX5		;RESTORE ACS
	PUSHJ FXP,RST5
	POP FXP,UNREAL		;WE'VE MADE SURE INTERRUPTS GET RUN, BUT MAY BE DEFFERING HERE
	JRST UNWPR2		
UNWNXT:	MOVE D,<-LEP1+1>+<CATRTN-ERRTN>(D) ;GO BACK ONE CATCH
	JUMPN D,UNWPR1		;IF MORE FRAMES TO CHECK THEN GO ON
UNWPRT:	POP FXP,TT
	POP FXP,R
	POP FXP,T
	POP FXP,D
	POPJ FXP,

IN *LISP >:

;here
FRETURN:  TDZA C,C		;LH OF C REMEMBERS WHICH ENTRY
FRETRY:	 MOVSI C,TRUTH
	HRR C,B
	JSP R,GTPDLP
	 0
	 JFCL
	MOVEI F,(D)
	MOVE TT,[$EVALFRAME]
	CAMN TT,1(F)
	 JRST FRETR1
	MOVE TT,[$APPLYFRAME]
	CAME TT,1(F)
	 JRST FRERR
FRETR1:	MOVEI D,(F)
	SUBI D,(P)
	HRLI D,(D)
	HRRI D,(F)
	MOVE TT,[$UIFRAME]
	CAME TT,(D)	;SEARCH FOR A USER INTERRUPT FRAME
	 AOBJN D,.-1
	CAMN TT,(D)
	 JSP TT,UIBRK
FRP1:	SKIPE T,PA4	;BREAK UP A DOMINEERING PROG
	 CAIL F,(T)		;[WHICH BREAKS UP INTERIOR ERRSETS AND CATCHES]
	  JRST FRP2
	MOVEI TT,FRP1-1		;FAKE OUT RETURN BY INSERTING A RETURN-ADDRESS
	MOVEM TT,-LPRP+1(T)	;OF FRP1 ON THE PDL
	JRST RETURN

FRP2:	SKIPE B,ERRTN		;BREAK UP A DOMINEERING ERRSET
FRP2A:   CAIL F,(B)
	  JRST FRP4
	MOVEI T,FRP1
	MOVEI TT,FRP1
	JRST BKRST0

FRP4:	SKIPE B,CATRTN		;BREAK UP A CATCH
	 CAIL F,(B)
	  JRST FRP3
	MOVEI T,FRP1		;IN CASE OF UNWIND-PROTECT
	MOVEI TT,FRP1
	JRST BKRST0

FRP3:	SKIPN B,EOFRTN	;BREAK OUT OF ANY E-O-F SET READS
	 JRST FRP3QA
	CAIGE F,(B)
	 JRST FRP2A
FRP3QA:	MOVEI A,(C)
IFE PAGING,[
	ADDI F,1		;FIX UP PDL POINTERS
	SUB F,C2
	HRLS F
	ADD F,C2
	MOVE P,F
	HRRZ F,-2(P)
	SUB F,FXC2
	HRLS F
	ADD F,FXC2
	MOVE FXP,F
	HLRZ F,-2(P)
	SUB F,FLC2
	HRLS F
	ADD F,FLC2
	MOVE FLP,F
]		;END OF IFE PAGING
IFN PAGING,[			;IN A PAGED SYSTEM, THE PDLOV HANDLER

IFN SAIL,[
	HRRZI P,1(F)
	FIXPDLP TT
	HLRZ FLP,-2(P)
	FIXPDLFLP TT
	HRRZ FXP,-2(P)
	FIXPDLFXP TT
]	;END OF IFN SAIL

SA%	HRROI P,1(F)		; WILL FIX UP THE LHS OF THE PDL PTRS
SA%	HLRO FLP,-2(P)
SA%	HRRO FXP,-2(P)
]		;END OF IFN PAGING
	HLRZ TT,-1(P)
	TLNN C,-1		;FOR "FRETURN" JUST UNBIND TO MARKED
	 JRST UBD		;  POINT, AND POP FRAME
	PUSHJ P,UBD
	HLRZ TT,(A)		;BUT DO MORE FOR "FRETRY", AFTER UBD
	JSP T,%CADDR
	POPI P,L$EVALFRAME	;GET RID OF BASIC EVALFRAME
	CAIE TT,QAPPLY
	  JRST EVAL
	HRRZ B,(A)
	HLRZ B,(B)
	HLRZ A,(A)
	HLRE T,(P)		;GET RID OF ARGS ON APPLYFRAME 
	SKIPG T			;FIGURE OUT LENGTH OF ARGS PART
	MOVEI T,1
	HRLI T,(T)
	SUB P,T
	JRST .APPLY